home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
kcl
/
kcl.lha
/
cmpnew
/
cmputil.c
< prev
next >
Wrap
C/C++ Source or Header
|
1987-06-04
|
17KB
|
743 lines
/* (C) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved. */
#include <cmpinclude.h>
#include "cmputil.h"
init_cmputil(start,size,data)char *start;int size;object data;
{ register object *base=vs_top;register object *sup=base+VM2;vs_top=sup;vs_check;
Cstart=start;Csize=size;Cdata=data;set_VV(VV,VM1,data);
MM(VV[70],L1,start,size,data);
VV[3]->s.s_stype=(short)stp_special;
if(VV[3]->s.s_dbind == OBJNULL){
VV[3]->s.s_dbind = VV[2];}
VV[4]->s.s_stype=(short)stp_special;
if(VV[4]->s.s_dbind == OBJNULL){
VV[4]->s.s_dbind = Ct;}
VV[6]->s.s_stype=(short)stp_special;
if(VV[6]->s.s_dbind == OBJNULL){
VV[6]->s.s_dbind = VV[5];}
base[0]= VV[7];
base[1]= make_cons(Cnil,Cnil);
(void)simple_symlispcall_no_event(VV[71],base+0,2);
data->v.v_self[12]=VV[12]=string_to_object(VV[12]);
vs_top=sup;
MF(VV[14],L4,start,size,data);
MM(VV[72],L5,start,size,data);
MF(VV[73],L6,start,size,data);
MF(VV[74],L7,start,size,data);
VV[17]->s.s_stype=(short)stp_special;
if(VV[17]->s.s_dbind == OBJNULL){
VV[17]->s.s_dbind = Cnil;}
MF(VV[75],L8,start,size,data);
VV[19]->s.s_stype=(short)stp_special;
if(VV[19]->s.s_dbind == OBJNULL){
VV[19]->s.s_dbind = Cnil;}
MF(VV[76],L9,start,size,data);
MF(VV[77],L10,start,size,data);
MF(VV[78],L11,start,size,data);
MF(VV[79],L12,start,size,data);
MM(VV[80],L13,start,size,data);
MM(VV[81],L14,start,size,data);
MM(VV[82],L15,start,size,data);
MM(VV[83],L16,start,size,data);
MF(VV[84],L17,start,size,data);
MF(VV[85],L18,start,size,data);
MF(VV[86],L19,start,size,data);
MF(VV[87],L20,start,size,data);
VV[52]->s.s_stype=(short)stp_special;
if(VV[52]->s.s_dbind == OBJNULL){
VV[52]->s.s_dbind = Cnil;}
MF(VV[88],L21,start,size,data);
MF(VV[89],L22,start,size,data);
vs_top=vs_base=base;
}
/* macro definition for SAFE-COMPILE */
static L1()
{ register object *base=vs_base;
register object *sup=base+VM3;
vs_reserve(VM3);
check_arg(2);
vs_top=sup;
{object V1=base[0]->c.c_cdr;
base[2]= V1;}
base[3]= listA(3,VV[0],VV[1],base[2]);
vs_top=(vs_base=base+3)+1;
return;
}
/* function definition for CMPERR */
static L4()
{ register object *base=vs_base;
register object *sup=base+VM4;
vs_reserve(VM4);
bds_check;
if(vs_top-vs_base<1) too_few_arguments();
vs_base=vs_base+1;
vs_top[0]=Cnil;
{object *p=vs_top;
for(;p>vs_base;p--)p[-1]=MMcons(p[-1],p[0]);}
vs_top=sup;
bds_bind(VV[9],VV[8]);
vs_base=vs_top;
L10();
vs_top=sup;
base[3]= Ct;
base[4]= VV[10];
vs_top=(vs_base=base+3)+2;
Lformat();
vs_top=sup;
base[3]= Ct;
base[4]= base[0];
{object V2;
V2= base[1];
vs_top=base+5;
while(!endp(V2))
{vs_push(car(V2));V2=cdr(V2);}
vs_base=base+3;}
Lformat();
vs_top=sup;
setq(VV[6],number_plus(symbol_value(VV[6]),VV[11]));
{frame_ptr fr;
fr=frs_sch_catch(VV[12]);
if(fr==NULL) FEerror("The tag ~s is undefined.",1,VV[12]);
base[3]= VV[7];
vs_top=(vs_base=base+3)+1;
unwind(fr,VV[12]);}
}
/* macro definition for CMPCK */
static L5()
{ register object *base=vs_base;
register object *sup=base+VM5;
vs_reserve(VM5);
check_arg(2);
vs_top=sup;
{object V3=base[0]->c.c_cdr;
if(endp(V3))invalid_macro_call();
base[2]= (V3->c.c_car);
V3=V3->c.c_cdr;
if(endp(V3))invalid_macro_call();
base[3]= (V3->c.c_car);
V3=V3->c.c_cdr;
base[4]= V3;}
base[5]= listA(3,VV[14],base[3],base[4]);
base[6]= list(3,VV[13],base[2],base[5]);
vs_top=(vs_base=base+6)+1;
return;
}
/* function definition for TOO-MANY-ARGS */
static L6()
{ register object *base=vs_base;
register object *sup=base+VM6;
vs_reserve(VM6);
bds_check;
check_arg(3);
vs_top=sup;
TTL:;
bds_bind(VV[9],VV[8]);
vs_base=vs_top;
L10();
vs_top=sup;
base[4]= Ct;
base[5]= VV[15];
base[6]= base[0];
base[7]= base[1];
base[8]= base[2];
vs_top=(vs_base=base+4)+5;
Lformat();
vs_top=sup;
setq(VV[6],number_plus(symbol_value(VV[6]),VV[11]));
{frame_ptr fr;
fr=frs_sch_catch(VV[12]);
if(fr==NULL) FEerror("The tag ~s is undefined.",1,VV[12]);
base[4]= VV[7];
vs_top=(vs_base=base+4)+1;
unwind(fr,VV[12]);}
}
/* function definition for TOO-FEW-ARGS */
static L7()
{ register object *base=vs_base;
register object *sup=base+VM7;
vs_reserve(VM7);
bds_check;
check_arg(3);
vs_top=sup;
TTL:;
bds_bind(VV[9],VV[8]);
vs_base=vs_top;
L10();
vs_top=sup;
base[4]= Ct;
base[5]= VV[16];
base[6]= base[0];
base[7]= base[1];
base[8]= base[2];
vs_top=(vs_base=base+4)+5;
Lformat();
vs_top=sup;
setq(VV[6],number_plus(symbol_value(VV[6]),VV[11]));
{frame_ptr fr;
fr=frs_sch_catch(VV[12]);
if(fr==NULL) FEerror("The tag ~s is undefined.",1,VV[12]);
base[4]= VV[7];
vs_top=(vs_base=base+4)+1;
unwind(fr,VV[12]);}
}
/* function definition for CMPWARN */
static L8()
{ register object *base=vs_base;
register object *sup=base+VM8;
vs_reserve(VM8);
bds_check;
if(vs_top-vs_base<1) too_few_arguments();
vs_base=vs_base+1;
vs_top[0]=Cnil;
{object *p=vs_top;
for(;p>vs_base;p--)p[-1]=MMcons(p[-1],p[0]);}
vs_top=sup;
bds_bind(VV[9],VV[8]);
if((symbol_value(VV[17]))!=Cnil){
goto T42;}
vs_base=vs_top;
L10();
vs_top=sup;
base[3]= Ct;
base[4]= VV[18];
vs_top=(vs_base=base+3)+2;
Lformat();
vs_top=sup;
base[3]= Ct;
base[4]= base[0];
{object V4;
V4= base[1];
vs_top=base+5;
while(!endp(V4))
{vs_push(car(V4));V4=cdr(V4);}
vs_base=base+3;}
Lformat();
vs_top=sup;
princ_char(10,Cnil);
T42:;
base[3]= Cnil;
vs_top=(vs_base=base+3)+1;
bds_unwind1;
return;
}
/* function definition for CMPNOTE */
static L9()
{ register object *base=vs_base;
register object *sup=base+VM9;
vs_reserve(VM9);
bds_check;
if(vs_top-vs_base<1) too_few_arguments();
vs_base=vs_base+1;
vs_top[0]=Cnil;
{object *p=vs_top;
for(;p>vs_base;p--)p[-1]=MMcons(p[-1],p[0]);}
vs_top=sup;
bds_bind(VV[9],VV[8]);
if((symbol_value(VV[19]))!=Cnil){
goto T53;}
princ_char(10,Cnil);
base[3]= Ct;
base[4]= VV[20];
vs_top=(vs_base=base+3)+2;
Lformat();
vs_top=sup;
base[3]= Ct;
base[4]= base[0];
{object V5;
V5= base[1];
vs_top=base+5;
while(!endp(V5))
{vs_push(car(V5));V5=cdr(V5);}
vs_base=base+3;}
Lformat();
vs_top=sup;
T53:;
base[3]= Cnil;
vs_top=(vs_base=base+3)+1;
bds_unwind1;
return;
}
/* function definition for PRINT-CURRENT-FORM */
static L10()
{ register object *base=vs_base;
register object *sup=base+VM10;
vs_reserve(VM10);
bds_check;
check_arg(0);
vs_top=sup;
TTL:;
if((symbol_value(VV[4]))==Cnil){
goto T63;}
setq(VV[4],Cnil);
vs_base=vs_top;
Lfresh_line();
vs_top=sup;
if(!(type_of(symbol_value(VV[3]))==t_cons)){
goto T70;}
if(!(car(symbol_value(VV[3]))==VV[21])){
goto T70;}
base[0]= Ct;
base[1]= VV[22];
base[2]= cdr(symbol_value(VV[3]));
vs_top=(vs_base=base+0)+3;
Lformat();
vs_top=sup;
goto T63;
T70:;
bds_bind(VV[23],VV[24]);
bds_bind(VV[25],VV[24]);
base[2]= Ct;
base[3]= VV[26];
base[4]= symbol_value(VV[3]);
vs_top=(vs_base=base+2)+3;
Lformat();
vs_top=sup;
bds_unwind1;
bds_unwind1;
T63:;
base[0]= Cnil;
vs_top=(vs_base=base+0)+1;
return;
}
/* function definition for UNDEFINED-VARIABLE */
static L11()
{ register object *base=vs_base;
register object *sup=base+VM11;
vs_reserve(VM11);
bds_check;
check_arg(1);
vs_top=sup;
TTL:;
bds_bind(VV[9],VV[8]);
vs_base=vs_top;
L10();
vs_top=sup;
base[2]= Ct;
base[3]= VV[27];
base[4]= base[0];
vs_top=(vs_base=base+2)+3;
Lformat();
vs_top=sup;
base[2]= Cnil;
vs_top=(vs_base=base+2)+1;
bds_unwind1;
return;
}
/* function definition for BABOON */
static L12()
{ register object *base=vs_base;
register object *sup=base+VM12;
vs_reserve(VM12);
bds_check;
check_arg(0);
vs_top=sup;
TTL:;
bds_bind(VV[9],VV[8]);
vs_base=vs_top;
L10();
vs_top=sup;
base[1]= Ct;
base[2]= VV[28];
vs_top=(vs_base=base+1)+2;
Lformat();
vs_top=sup;
setq(VV[6],number_plus(symbol_value(VV[6]),VV[11]));
symlispcall_no_event(VV[90],base+1,0);
bds_unwind1;
return;
}
/* macro definition for DOLIST* */
static L13()
{ register object *base=vs_base;
register object *sup=base+VM13;
vs_reserve(VM13);
check_arg(2);
vs_top=sup;
{object V6=base[0]->c.c_cdr;
if(endp(V6))invalid_macro_call();
{object V7= (V6->c.c_car);
if(endp(V7))invalid_macro_call();
base[2]= (V7->c.c_car);
V7=V7->c.c_cdr;
if(endp(V7))invalid_macro_call();
base[3]= (V7->c.c_car);
V7=V7->c.c_cdr;
if(endp(V7)){
base[4]= Cnil;
} else {
base[4]= (V7->c.c_car);
V7=V7->c.c_cdr;}
if(!endp(V7))invalid_macro_call();}
V6=V6->c.c_cdr;
base[5]= V6;}
vs_base=vs_top;
Lgensym();
vs_top=sup;
base[6]= vs_base[0];
base[7]= list(2,VV[30],base[6]);
base[8]= list(3,base[6],base[3],base[7]);
base[9]= list(2,VV[31],base[6]);
base[10]= list(2,VV[31],base[6]);
base[11]= list(3,base[2],base[9],base[10]);
base[12]= list(2,base[8],base[11]);
base[13]= list(2,VV[32],base[6]);
base[14]= list(2,base[13],base[4]);
base[15]= list(2,VV[34],base[2]);
base[16]= list(2,VV[33],base[15]);
base[17]= listA(5,VV[29],base[12],base[14],base[16],base[5]);
vs_top=(vs_base=base+17)+1;
return;
}
/* macro definition for DOLIST** */
static L14()
{ register object *base=vs_base;
register object *sup=base+VM14;
vs_reserve(VM14);
check_arg(2);
vs_top=sup;
{object V8=base[0]->c.c_cdr;
if(endp(V8))invalid_macro_call();
{object V9= (V8->c.c_car);
if(endp(V9))invalid_macro_call();
base[2]= (V9->c.c_car);
V9=V9->c.c_cdr;
if(endp(V9))invalid_macro_call();
base[3]= (V9->c.c_car);
V9=V9->c.c_cdr;
if(endp(V9)){
base[4]= Cnil;
} else {
base[4]= (V9->c.c_car);
V9=V9->c.c_cdr;}
if(!endp(V9))invalid_macro_call();}
V8=V8->c.c_cdr;
base[5]= V8;}
vs_base=vs_top;
Lgensym();
vs_top=sup;
base[6]= vs_base[0];
base[7]= list(2,VV[30],base[6]);
base[8]= list(3,base[6],base[3],base[7]);
base[9]= list(2,VV[31],base[6]);
base[10]= list(2,VV[31],base[6]);
base[11]= list(3,base[2],base[9],base[10]);
base[12]= list(2,base[8],base[11]);
base[13]= list(2,VV[32],base[6]);
base[14]= list(2,base[13],base[4]);
base[15]= list(3,VV[34],base[6],base[2]);
base[16]= list(2,VV[33],base[15]);
base[17]= listA(5,VV[29],base[12],base[14],base[16],base[5]);
vs_top=(vs_base=base+17)+1;
return;
}
/* macro definition for DOTIMES* */
static L15()
{ register object *base=vs_base;
register object *sup=base+VM15;
vs_reserve(VM15);
check_arg(2);
vs_top=sup;
{object V10=base[0]->c.c_cdr;
if(endp(V10))invalid_macro_call();
{object V11= (V10->c.c_car);
if(endp(V11))invalid_macro_call();
base[2]= (V11->c.c_car);
V11=V11->c.c_cdr;
if(endp(V11))invalid_macro_call();
base[3]= (V11->c.c_car);
V11=V11->c.c_cdr;
if(endp(V11)){
base[4]= Cnil;
} else {
base[4]= (V11->c.c_car);
V11=V11->c.c_cdr;}
if(!endp(V11))invalid_macro_call();}
V10=V10->c.c_cdr;
base[5]= V10;}
vs_base=vs_top;
Lgensym();
vs_top=sup;
base[6]= vs_base[0];
base[7]= list(2,base[6],base[3]);
base[8]= list(2,VV[35],base[2]);
base[9]= list(3,base[2],VV[5],base[8]);
base[10]= list(2,base[7],base[9]);
base[11]= list(3,VV[36],base[2],base[6]);
base[12]= list(2,base[11],base[4]);
base[13]= list(2,VV[37],base[2]);
base[14]= list(2,VV[33],base[13]);
base[15]= listA(5,VV[29],base[10],base[12],base[14],base[5]);
vs_top=(vs_base=base+15)+1;
return;
}
/* macro definition for DOTIMES** */
static L16()
{ register object *base=vs_base;
register object *sup=base+VM16;
vs_reserve(VM16);
check_arg(2);
vs_top=sup;
{object V12=base[0]->c.c_cdr;
if(endp(V12))invalid_macro_call();
{object V13= (V12->c.c_car);
if(endp(V13))invalid_macro_call();
base[2]= (V13->c.c_car);
V13=V13->c.c_cdr;
if(endp(V13))invalid_macro_call();
base[3]= (V13->c.c_car);
V13=V13->c.c_cdr;
if(endp(V13)){
base[4]= Cnil;
} else {
base[4]= (V13->c.c_car);
V13=V13->c.c_cdr;}
if(!endp(V13))invalid_macro_call();}
V12=V12->c.c_cdr;
base[5]= V12;}
vs_base=vs_top;
Lgensym();
vs_top=sup;
base[6]= vs_base[0];
base[7]= list(2,base[6],base[3]);
base[8]= list(2,VV[35],base[2]);
base[9]= list(3,base[2],VV[5],base[8]);
base[10]= list(2,base[7],base[9]);
base[11]= list(3,VV[36],base[2],base[6]);
base[12]= list(2,base[11],base[4]);
base[13]= list(3,VV[37],base[6],base[2]);
base[14]= list(2,VV[33],base[13]);
base[15]= listA(5,VV[29],base[10],base[12],base[14],base[5]);
vs_top=(vs_base=base+15)+1;
return;
}
/* function definition for CMP-EVAL */
static L17()
{ register object *base=vs_base;
register object *sup=base+VM17;
vs_reserve(VM17);
bds_check;
check_arg(1);
vs_top=sup;
TTL:;
base[3]= list(2,VV[39],base[0]);
base[2]= list(2,VV[38],base[3]);
vs_top=(vs_base=base+2)+1;
L21();
Llist();
vs_top=sup;
base[1]= vs_base[0];
if((car(base[1]))==Cnil){
goto T103;}
bds_bind(VV[9],VV[8]);
setq(VV[6],number_plus(symbol_value(VV[6]),VV[11]));
vs_base=vs_top;
L10();
vs_top=sup;
base[3]= Ct;
base[4]= VV[40];
base[5]= base[0];
vs_top=(vs_base=base+3)+3;
Lformat();
vs_top=sup;
base[3]= Cnil;
vs_top=(vs_base=base+3)+1;
bds_unwind1;
return;
T103:;
base[2]= cdr(base[1]);
vs_top=(vs_base=base+2)+1;
Lvalues_list();
return;
}
/* function definition for CMP-MACROEXPAND */
static L18()
{ register object *base=vs_base;
register object *sup=base+VM18;
vs_reserve(VM18);
bds_check;
check_arg(1);
vs_top=sup;
TTL:;
base[3]= list(2,VV[39],base[0]);
base[2]= list(2,VV[41],base[3]);
vs_top=(vs_base=base+2)+1;
L21();
Llist();
vs_top=sup;
base[1]= vs_base[0];
if((car(base[1]))==Cnil){
goto T117;}
bds_bind(VV[9],VV[8]);
setq(VV[6],number_plus(symbol_value(VV[6]),VV[11]));
vs_base=vs_top;
L10();
vs_top=sup;
base[3]= Ct;
base[4]= VV[42];
base[5]= base[0];
vs_top=(vs_base=base+3)+3;
Lformat();
vs_top=sup;
base[3]= list(2,VV[39],base[0]);
base[4]= list(3,VV[43],VV[44],base[3]);
vs_top=(vs_base=base+4)+1;
bds_unwind1;
return;
T117:;
base[2]= cadr(base[1]);
vs_top=(vs_base=base+2)+1;
return;
}
/* function definition for CMP-MACROEXPAND-1 */
static L19()
{ register object *base=vs_base;
register object *sup=base+VM19;
vs_reserve(VM19);
bds_check;
check_arg(1);
vs_top=sup;
TTL:;
base[3]= list(2,VV[39],base[0]);
base[2]= list(2,VV[45],base[3]);
vs_top=(vs_base=base+2)+1;
L21();
Llist();
vs_top=sup;
base[1]= vs_base[0];
if((car(base[1]))==Cnil){
goto T130;}
bds_bind(VV[9],VV[8]);
setq(VV[6],number_plus(symbol_value(VV[6]),VV[11]));
vs_base=vs_top;
L10();
vs_top=sup;
base[3]= Ct;
base[4]= VV[46];
base[5]= base[0];
vs_top=(vs_base=base+3)+3;
Lformat();
vs_top=sup;
base[3]= list(2,VV[39],base[0]);
base[4]= list(3,VV[43],VV[47],base[3]);
vs_top=(vs_base=base+4)+1;
bds_unwind1;
return;
T130:;
base[2]= cadr(base[1]);
vs_top=(vs_base=base+2)+1;
return;
}
/* function definition for CMP-EXPAND-MACRO */
static L20()
{ register object *base=vs_base;
register object *sup=base+VM20;
vs_reserve(VM20);
bds_check;
check_arg(3);
vs_top=sup;
TTL:;
base[5]= list(2,VV[39],base[0]);
base[6]= make_cons(base[1],base[2]);
base[7]= list(2,VV[39],base[6]);
base[4]= list(5,VV[48],VV[49],base[5],base[7],Cnil);
vs_top=(vs_base=base+4)+1;
L21();
Llist();
vs_top=sup;
base[3]= vs_base[0];
if((car(base[3]))==Cnil){
goto T143;}
bds_bind(VV[9],VV[8]);
setq(VV[6],number_plus(symbol_value(VV[6]),VV[11]));
vs_base=vs_top;
L10();
vs_top=sup;
base[5]= Ct;
base[6]= VV[50];
base[7]= base[1];
vs_top=(vs_base=base+5)+3;
Lformat();
vs_top=sup;
base[5]= make_cons(base[1],base[2]);
base[6]= list(2,VV[39],base[5]);
base[7]= list(3,VV[43],VV[51],base[6]);
vs_top=(vs_base=base+7)+1;
bds_unwind1;
return;
T143:;
base[4]= cadr(base[3]);
vs_top=(vs_base=base+4)+1;
return;
}
/* function definition for CMP-TOPLEVEL-EVAL */
static L21()
{ register object *base=vs_base;
register object *sup=base+VM21;
vs_reserve(VM21);
bds_check;
check_arg(1);
vs_top=sup;
TTL:;
bds_bind(VV[53],symbol_value(VV[54]));
base[3]= simple_symlispcall_no_event(VV[91],base+4,0);
bds_bind(VV[54],one_minus(base[3]));
bds_bind(VV[55],symbol_value(VV[52]));
base[6]= VV[57];
vs_top=(vs_base=base+6)+1;
Lfind_package();
vs_top=sup;
base[5]= vs_base[0];
bds_bind(VV[56],make_cons(base[5],symbol_value(VV[56])));
base[5]= base[0];
vs_top=(vs_base=base+5)+1;
siLerror_set();
bds_unwind1;
bds_unwind1;
bds_unwind1;
bds_unwind1;
return;
}
/* function definition for COMPILER-CLEAR-COMPILER-PROPERTIES */
static L22()
{ register object *base=vs_base;
register object *sup=base+VM22;
vs_reserve(VM22);
check_arg(1);
vs_top=sup;
TTL:;
(void)(remprop(base[0],VV[58]));
(void)(remprop(base[0],VV[59]));
(void)(remprop(base[0],VV[60]));
(void)(remprop(base[0],VV[61]));
(void)(remprop(base[0],VV[62]));
(void)(remprop(base[0],VV[63]));
(void)(remprop(base[0],VV[64]));
(void)(remprop(base[0],VV[65]));
(void)(remprop(base[0],VV[66]));
(void)(remprop(base[0],VV[67]));
(void)(remprop(base[0],VV[68]));
base[1]= remprop(base[0],VV[69]);
vs_top=(vs_base=base+1)+1;
return;
}